home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 23.zip / BS1 part 23 / Hisoft Basic v1.03 disk 2.adf / graphics / sdm.bas < prev    next >
BASIC Source File  |  1988-12-19  |  10KB  |  441 lines
  1. Setup:
  2.   DIM Number$(58),Desc$(58),Value$(58)
  3.   DIM Array$(50),Array(50)
  4.   FOR x=1 TO 58
  5.     IF x>4 AND x<55 THEN Number$(x)=STR$(x-4)
  6.   NEXT x
  7.   TopLine=1
  8.  
  9.   Colors=3
  10.   SCREEN 4,640,200,Colors,2
  11.   WINDOW 5,"Graphics",,20,4
  12.   PALETTE 7,.8,.2,.1
  13.  
  14.   WINDOW 1,"Statistical-Data-Manager",(0,12)-(631,111),22,-1
  15.  
  16.   MENU 1,0,1,"Data  "  
  17.   MENU 1,1,1,"Load  "
  18.   MENU 1,2,1,"Save  "
  19.   MENU 1,3,1,"Print "
  20.   MENU 1,4,1,"Delete"
  21.   MENU 1,5,1,"Quit  "
  22.   MENU 2,0,1,"Graphics"
  23.   MENU 2,1,1,"Bar Graph"
  24.   MENU 2,2,1,"Pie Chart"
  25.   MENU 2,3,1,"Save Pic"
  26.   MENU 3,0,0,""
  27.   MENU 4,0,0,""
  28.  
  29.   ON MENU GOSUB MenuControl
  30.   MENU ON
  31.  
  32. GOTO MainLoop
  33.  
  34. MenuControl:
  35.   Men=MENU(0) : MenuPoint=MENU(1)
  36.   IF Men=1 THEN
  37.     IF MenuPoint=1 THEN GOSUB LoadData
  38.     IF MenuPoint=2 THEN GOSUB SaveData
  39.     IF MenuPoint=3 THEN GOSUB PrintData
  40.     IF MenuPoint=4 THEN GOSUB ClearData
  41.     IF MenuPoint=5 THEN Quit
  42.   END IF
  43.   IF Men=2 THEN
  44.     IF MenuPoint=3 THEN
  45.       MENU 1,0,0: MENU 2,0,0
  46.       MENU OFF
  47.         GOSUB EnterName
  48.       WINDOW 5
  49.         PicSave Nam$,5,0
  50.       WINDOW 1
  51.       MENU ON
  52.       MENU 1,0,1 : MENU 2,0,1
  53.     END IF
  54.     IF MenuPoint=1 THEN Array$(0)="B"
  55.     IF MenuPoint=2 THEN Array$(0)="P"
  56.     Array(0)=TopLine
  57.     IF Value$(Array(0)+4)="" THEN Array(0)=Array(0)-1
  58.     FOR x=1 TO Array(0)
  59.       Array$(x)=Desc$(x+4)
  60.       Array(x)=VAL(Value$(x+4))
  61.       IF Array(x)=0 THEN Array(x)=.01
  62.     NEXT x
  63.     MENU OFF
  64.     MENU 1,0,0 : MENU 2,0,0
  65.     WINDOW 5 : CLS
  66.     
  67.     GOSUB Graphics
  68.     
  69.     WINDOW 2,"Please press a key!",(350,0)-(631,0),20,4
  70.     COLOR 0,1 : CLS
  71.     WHILE INKEY$=""
  72.     WEND
  73.     WINDOW CLOSE 2
  74.     WINDOW 1
  75.     MENU ON
  76.     MENU 1,0,1 : MENU 2,0,1       
  77.   END IF
  78. RETURN       
  79.  
  80. MainLoop:
  81.   CLS
  82.   IF TopLine>50 THEN TopLine=50
  83.   IF LineOne>TopLine THEN LineOne=TopLine : BEEP
  84.   IF LineOne<1 THEN LineOne=1 : BEEP
  85.   PRINT "Number";TAB(10);"Description";TAB(45);"Value"
  86.   FOR x=LineOne TO LineOne+8
  87.     COLOR 1,0
  88.     PRINT Number$(x);TAB(10);Desc$(x);TAB(45);Value$(x)
  89.   NEXT x
  90.   IF DescData=0 THEN StartSlice=10 : EndSlice=40
  91.   IF DescData=1 THEN StartSlice=45 : EndSlice=55
  92.   xp=StartSlice
  93.  
  94.   GOSUB EnterText
  95.   in$=""
  96.  
  97. GOTO MainLoop
  98.  
  99.  
  100. EnterText:
  101.   IF xp<StartSlice THEN xp=StartSlice
  102.   LOCATE 6,xp
  103.   COLOR 0,3 : PRINT " "; : COLOR 1,0
  104.   i$=INKEY$
  105.   IF i$="" THEN EnterText
  106.   IF i$=CHR$(2) THEN LineOne=1 : RETURN
  107.   IF i$=CHR$(5) THEN LineOne=TopLine : RETURN
  108.   IF i$=CHR$(4) THEN DeleteLine : RETURN
  109.   IF i$=CHR$(14) THEN InsertLine : RETURN
  110.   IF i$=CHR$(28) THEN GOSUB AcceptText : xp=StartSlice : LineOne=LineOne-1: RETURN
  111.   IF i$=CHR$(29) THEN GOSUB AcceptText : xp=StartSlice : LineOne=LineOne+1: RETURN
  112.   
  113.   TextPos=xp-StartSlice+1
  114.   IF DescData=0 THEN Text$=Desc$(LineOne+4)
  115.   IF DescData=1 THEN Text$=Value$(LineOne+4)
  116.  
  117.   IF i$=CHR$(30) THEN
  118.     IF TextPos<=LEN(Text$) THEN i$=MID$(Text$,TextPos,1)
  119.   END IF 
  120.  
  121.   IF i$=CHR$(13) OR i$=CHR$(9) THEN
  122.     GOSUB AcceptText
  123.     DescData=1-DescData
  124.     IF DescData=0 THEN LineOne=LineOne+1
  125.     xp=StartSlice
  126.     IF TopLine<LineOne THEN TopLine=LineOne
  127.     RETURN
  128.   END IF
  129.   IF i$=CHR$(8) OR i$=CHR$(31) THEN
  130.     LOCATE 6,xp
  131.     IF TextPos<=LEN(Text$) THEN
  132.       PRINT RIGHT$(Text$,LEN(Text$)-TextPos+1);
  133.     ELSE
  134.       PRINT " ";
  135.     END IF
  136.     xp=xp-1 : IF xp<StartSlice THEN xp=StartSlice : BEEP : GOTO EnterText
  137.     in$=LEFT$(in$,(LEN(in$)-1))
  138.     GOTO EnterText
  139.   END IF
  140.   IF i$=CHR$(34) THEN i$=CHR$(39)
  141.   IF i$ > CHR$(31) AND i$ < CHR$(127) THEN
  142.     IF xp>=EndSlice THEN xp=EndSlice : BEEP : GOTO EnterText
  143.     LOCATE 6,xp
  144.     PRINT i$;
  145.     in$=in$+i$
  146.     xp=xp+1
  147.   END IF
  148. GOTO EnterText
  149.  
  150. AcceptText:
  151.   IF in$<>"" THEN
  152.     IF DescData=0 THEN Desc$(LineOne+4)=in$
  153.     IF DescData=1 THEN Value$(LineOne+4)=in$
  154.     in$=""
  155.     AltData=1
  156.   END IF
  157. RETURN
  158.  
  159. DeleteLine:
  160.   FOR x=LineOne+4 TO 54
  161.     Desc$(x)=Desc$(x+1)
  162.     Value$(x)=Value$(x+1)
  163.   NEXT x
  164.   TopLine=TopLine-1
  165.   IF TopLine<1 THEN TopLine=1
  166. RETURN
  167.  
  168. InsertLine:
  169.   IF TopLine>=50 THEN BEEP : RETURN
  170.   FOR x=TopLine+4 TO LineOne+4 STEP -1
  171.     Desc$(x+1)=Desc$(x)
  172.     Value$(x+1)=Value$(x)
  173.   NEXT x
  174.   Desc$(LineOne+4)=""
  175.   Value$(LineOne+4)=""
  176.   TopLine=TopLine+1
  177. RETURN
  178.  
  179. SaveData:
  180.   MENU 1,0,0 : MENU 2,0,0 
  181.   MENU OFF
  182.   GOSUB EnterName
  183.   WINDOW 1
  184.   IF Nam$="" THEN EndSave
  185.   OPEN Nam$ FOR OUTPUT AS 1
  186.     PRINT #1,TopLine+4
  187.     FOR x=1 TO TopLine+4
  188.       WRITE #1,Desc$(x)
  189.       WRITE #1,Value$(x)
  190.     NEXT x
  191.   CLOSE 1
  192.   
  193. EndSave:
  194.   MENU 1,0,1 : MENU 2,0,1
  195.   MENU ON
  196.   AltData=0
  197. RETURN
  198.  
  199. LoadData:
  200.   IF AltData=1 THEN GOSUB Query
  201.   MENU 1,0,0 : MENU 2,0,0
  202.   MENU OFF
  203.   GOSUB EnterName
  204.   WINDOW 1
  205.   IF Nam$="" THEN EndLoad
  206.   FOR x=1 TO 58
  207.     Desc$(x)=""
  208.     Value$(x)=""
  209.   NEXT x
  210.   OPEN Nam$ FOR INPUT AS 1
  211.     INPUT #1,NmbrData
  212.     TopLine=NmbrData-4
  213.     FOR x=1 TO NmbrData
  214.       INPUT #1,Desc$(x)
  215.       INPUT #1,Value$(x)
  216.     NEXT x
  217.     LineOne=TopLine
  218.   CLOSE 1
  219.   
  220. EndLoad:
  221.   WINDOW 1
  222.   COLOR 1,0
  223.   CLS
  224.   PRINT "Number";TAB(10);"Description";TAB(45);"Array"
  225.   FOR x=LineOne TO LineOne+8
  226.     PRINT Number$(x);TAB(10);Desc$(x);TAB(45);Value$(x)
  227.   NEXT x
  228.   MENU 1,0,1 : MENU 2,0,1
  229.   MENU ON
  230.   AltData=0
  231. RETURN
  232.        
  233. EnterName:
  234.   Altname$=Nam$
  235.   WINDOW 2,"Enter filename:",(50,80)-(580,88),0,-1
  236.   CLS
  237.   LINE INPUT Nam$
  238.   IF Nam$= "=" OR Nam$="*" THEN Nam$=Altname$
  239.   WINDOW CLOSE 2
  240. RETURN
  241.  
  242. PrintData:
  243.   MENU 1,0,0 : MENU 2,0,0
  244.   MENU OFF
  245.   OPEN "PRT:" FOR OUTPUT AS 1
  246.     PRINT #1,"File:";Altname$;CHR$(10)
  247.     PRINT #1,"Number";TAB(10);"Description";TAB(45);"Value"
  248.     FOR x=4 TO TopLine+4
  249.       PRINT #1, Number$(x);TAB(10);Desc$(x);TAB(45);Value$(x)
  250.     NEXT x
  251.   CLOSE 1
  252.   MENU 1,0,1 : MENU 2,0,1
  253.   MENU ON
  254. RETURN
  255.  
  256. Query:
  257.   WINDOW 2,"Attention!",(155,50)-(475,135),0,-1
  258.   COLOR 0,1
  259.   CLS
  260.   LOCATE 2,3
  261.   PRINT  "     Your data has not"
  262.   PRINT  "        yet been saved."
  263.   PRINT : PRINT  "          Save it now?"
  264.   LOCATE 8,12 : PRINT "Yes"
  265.   LOCATE 8,21 : PRINT "No"
  266.   LINE (95,57)-(148,74),0,b
  267.   LINE (183,57)-(236,74),0,b
  268.   BEEP
  269. WaitforMouse:
  270.   Test=MOUSE(0)
  271.   WHILE MOUSE(0)=0
  272.   WEND
  273.   x=MOUSE(1) : y=MOUSE(2)
  274.   IF 95<x AND x<148 AND 57<y AND y<74 THEN
  275.     PAINT (97,59),3,0
  276.     GOSUB SaveData
  277.     PAINT (97,59),1,0
  278.     WINDOW CLOSE 2
  279.     RETURN
  280.   END IF
  281.   IF 183<x AND x<236 AND 57<y AND y<74 THEN
  282.     PAINT (185,59),3,0
  283.     WINDOW CLOSE 2
  284.     RETURN
  285.   END IF
  286.   GOTO WaitforMouse
  287.  
  288. ClearData:
  289.   IF AltData=1 THEN GOSUB Query
  290.   RUN
  291.   
  292. Quit:
  293.   IF AltData=1 THEN GOSUB Query
  294.   COLOR 1,0
  295.   MENU RESET
  296.   CLS
  297. END
  298.  
  299. Graphics:
  300.   IF Array(0)=0 THEN RETURN 
  301.   IF UCASE$(Array$(0))="B" THEN GOSUB BarGraph
  302.   IF UCASE$(Array$(0))="P" THEN GOSUB PieChart
  303. RETURN
  304.  
  305. PieChart:
  306.   Total=0
  307.   FOR x=1 TO Array(0)
  308.     Total=Total+Array(x)
  309.   NEXT x
  310.   Divi=Total/6.283 : Angle1=.02 : BColor=1
  311.   FOR x=1 TO Array(0)
  312.     LColor=BColor
  313.     IF LColor>(2^Colors)-1 THEN LColor=1
  314.     BColor=LColor+1
  315.     IF BColor>(2^Colors)-1 THEN BColor=1
  316.     Angle2=Angle1+Array(x)/Divi
  317.     CIRCLE (320,100),156,BColor 
  318.     CIRCLE (320,100),150,BColor,-Angle2,-Angle1
  319.     PAINT (320,32),LColor,BColor
  320.     CIRCLE (320,100),150,BColor
  321.     PAINT (320,32),0,BColor
  322.     CIRCLE (320,100),150,BColor,-Angle1,-Angle2
  323.     MidAngle=(Angle1+Angle2)/2
  324.     px=320+165*COS(MidAngle)
  325.     py=100-80*SIN(MidAngle)
  326.     Distance=0
  327.     IF MidAngle>1.57 AND MidAngle<4.72 THEN Distance=LEN(Array$(x))
  328.     IF Distance>15 THEN Distance=15
  329.     COLOR LColor,0
  330.     LOCATE (py/9.25)+1,(px/9.95)+1-Distance
  331.     PRINT Array$(x);
  332.     Angle1=Angle2
  333.   NEXT x
  334.  
  335.   CIRCLE (320,100),156,0
  336. RETURN
  337.  
  338. BarGraph:                       
  339.   Max=.0001 : LColor=0
  340.   FOR x=1 TO Array(0)
  341.     IF Array(x)>Max THEN Max=Array(x)
  342.   NEXT x
  343.   BarWidth=INT(550/(Array(0)))
  344.   IF BarWidth>100 THEN BarWidth=100
  345.   Factor=160/Max
  346.   LOCATE 1,1 : PRINT Max;
  347.   LOCATE 10,1 : PRINT Max/2;
  348.   FOR x=0 TO 10
  349.     LINE (1,170-x*16)-(5,170-x*16)
  350.   NEXT x 
  351.   FOR x=1 TO Array(0)
  352.     LColor=LColor+1 : IF LColor>(2^Colors)-1 THEN LColor=1
  353.     LINE (30+(x-1)*BarWidth,170-Array(x)*Factor)-(25+x*BarWidth,170),LColor,bf
  354.     COLOR LColor,0
  355.     LOCATE 20,(4+(x-1)*(BarWidth/9.9))
  356.     PRINT Array$(x);
  357.   NEXT x
  358. RETURN
  359.  
  360. SUB PicSave (Nam$,WindowNr%,ArrayYN%) STATIC
  361.   IF ArrayYN%=1 THEN SHARED Colors%()
  362.   IF ArrayYN%=0 THEN
  363.     IF Colors%(0,0)<>2 THEN ERASE Colors% : DIM Colors%(31,2)
  364.     RESTORE ColorTable
  365.     FOR x=0 TO 31
  366.       READ Colors%(x,0),Colors%(x,1),Colors%(x,2)
  367.     NEXT x
  368.   ColorTable:  
  369.     DATA 2,3,10, 15,15,15, 0,0,0, 15,8,0
  370.     DATA 0,0,15, 15,0,15, 0,15,15, 15,15,15
  371.     DATA 6,1,1, 14,5,0, 8,15,0, 14,11,0
  372.     DATA 5,5,15, 9,0,15, 0,15,9, 12,12,12
  373.     DATA 0,0,0, 13,0,0, 0,0,0, 15,12,10
  374.     DATA 4,4,4, 5,5,5, 6,6,6, 7,7,7
  375.     DATA 8,8,8, 9,9,9, 10,10,10, 11,11,11
  376.     DATA 12,12,12, 13,13,13, 14,14,14, 15,15,15
  377.   END IF
  378.   IF Nam$="" THEN EXIT SUB
  379.   AltWindowNr=WINDOW(1)
  380.   WINDOW WindowNr%
  381.   Wide=WINDOW(2)
  382.     IF Wide>320 THEN
  383.       Wide=640
  384.       Resolution=2
  385.       Planes=16000
  386.     ELSE
  387.       Wide=320
  388.       Resolution=1
  389.       Planes=8000
  390.     END IF
  391.   Height=WINDOW(3)
  392.     IF Height>200 THEN
  393.       Height=400
  394.       Planes=Planes*2
  395.       Resolution=Resolution+2
  396.     ELSE
  397.       Height=200
  398.     END IF
  399.   Colors=LOG(WINDOW(6)+1)/LOG(2)
  400.  
  401.   OPEN Nam$ FOR OUTPUT AS 1 LEN=FRE(0)-500
  402.     PRINT #1,"FORM";
  403.     PRINT #1,MKL$(156+Planes*Colors);
  404.     PRINT #1,"ILBM";
  405.     PRINT #1,"BMHD";MKL$(20);
  406.     PRINT #1,MKI$(Wide);MKI$(Height);
  407.     PRINT #1,MKL$(0);
  408.     PRINT #1,CHR$(Colors);
  409.     PRINT #1,CHR$(0);MKI$(0);MKI$(0);
  410.     PRINT #1,CHR$(10);CHR$(11);
  411.     PRINT #1,MKI$(Wide);MKI$(Height);
  412.     
  413.     PRINT #1,"CMAP";MKL$(96); 
  414.     FOR x=0 TO 31
  415.       PRINT #1,CHR$(Colors%(x,0)*16);
  416.       PRINT #1,CHR$(Colors%(x,1)*16);
  417.       PRINT #1,CHR$(Colors%(x,2)*16);
  418.     NEXT x
  419.     
  420.     PRINT #1,"BODY";MKL$(Planes*Colors);
  421.     Addr=PEEKL(WINDOW(8)+4)+8
  422.     FOR x=0 TO Colors-1
  423.       PlaneAddr(x)=PEEKL(Addr+4*x)
  424.     NEXT x
  425.     FOR y1=0 TO Height-1
  426.       FOR b=0 TO Colors-1
  427.         FOR x1=0 TO (Wide/32)-1 
  428.           PRINT#1,MKL$(PEEKL(PlaneAddr(b)+4*x1+(Wide/8)*y1));
  429.         NEXT x1
  430.       NEXT b
  431.       PAddr=PlaneAddr(0)+(Wide/8)*y1
  432.       POKE PAddr,PEEK(PAddr) AND 63
  433.       POKE PAddr+Wide/8-1,PEEK(PAddr+Wide/8-1) AND 252
  434.     NEXT y1
  435.     
  436.     PRINT #1,"CAMG";MKL$(4);
  437.     PRINT #1,MKL$(16384);
  438.   CLOSE 1
  439.   WINDOW AltWindowNr  
  440. END SUB
  441.